home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PAS_0493 / FADEDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1993-04-29  |  2KB  |  69 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 592 of 708
  3. From : Reynir Stefansson                   2:391/20.0           14 Apr 93  17:32
  4. To   : All
  5. Subj : Yafir...
  6. ────────────────────────────────────────────────────────────────────────────────
  7.      Here is yet another fade-in routine. This one does a proportional fade
  8. of all colours. }
  9.  
  10. PROGRAM FadeDemo;
  11.  
  12. USES Crt;
  13.  
  14. CONST PelAddrRgR  = $3C7;
  15.       PelAddrRgW  = $3C8;
  16.       PelDataReg  = $3C9;
  17.  
  18. TYPE rgb = RECORD r, g, b : BYTE; END;
  19.  
  20. VAR i : INTEGER; ch : CHAR; col : ARRAY[0..63] OF rgb;
  21.  
  22. PROCEDURE GetCol(C : BYTE; VAR R, G, B : BYTE);
  23. BEGIN
  24.    Port[PelAddrRgR] := C;
  25.    R := Port[PelDataReg];
  26.    G := Port[PelDataReg];
  27.    B := Port[PelDataReg];
  28. END;
  29.  
  30. PROCEDURE SetCol(C, R, G, B : BYTE);
  31. BEGIN
  32.    Port[PelAddrRgW] := C;
  33.    Port[PelDataReg] := R;
  34.    Port[PelDataReg] := G;
  35.    Port[PelDataReg] := B;
  36. END;
  37.  
  38. PROCEDURE SetInten(b : BYTE);
  39. VAR i : INTEGER; fr, fg, fb : BYTE;
  40. BEGIN
  41.    FOR i := 0 TO 63 DO
  42.    BEGIN
  43.       fr := col[i].r*b DIV 63;
  44.       fg := col[i].g*b DIV 63;
  45.       fb := col[i].b*b DIV 63;
  46.       SetCol(i, fr, fg, fb);
  47.    END;
  48. END;
  49.  
  50. BEGIN
  51.    TextMode(LastMode);
  52.    FOR i := 0 TO 63 DO GetCol(i, col[i].r, col[i].g, col[i].b);
  53.    FOR i := 1 TO 15 DO
  54.    BEGIN
  55.       TextAttr := i;
  56.       WriteLn('Foreground colour = ', i:2);
  57.    END;
  58.    ch := ReadKey;
  59.    FOR i := 63 DOWNTO 0 DO BEGIN SetInten(i); Delay(20); END;
  60.    GotoXY(1, 1);
  61.    FOR i := 15 DOWNTO 1 DO
  62.    BEGIN
  63.       TextAttr := i;
  64.       WriteLn('Foreground colour = ', i:2);
  65.    END;
  66.    FOR i := 0 TO 63 DO BEGIN SetInten(i); Delay(20); END;
  67.    ch := ReadKey;
  68.    TextMode(LastMode);
  69. END.